perm filename MAP.1[MAC,LSP] blob
sn#564917 filedate 1981-02-17 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 Returns the list which is the memory map.
C00005 ENDMK
Cā;
;;; Returns the list which is the memory map.
(defun mem-map ()
(let ((st (getddtsym 'st)))
(do ((i (+ st #o777) (1- i))
(l))
((< i st) l)
(push (mem-type (examine i))
l))))
(defun bit macro (x)
((lambda (x y)
((lambda (first)
(cond ((< y 1) first)
(t (lsh first y))))
(cond ((< x 1) 1)
(t (lsh 1 (* 9 x))))))
(- (cadr x) 1)
(- (caddr x) 1)))
(defun mem-type (w)
(setq w (lsh w -18.))
(cond ((not (= 0 (boole 1 (bit 2 8) w)))
(cond ((not (= 0 (boole 1 (bit 2 9) w))) 'list)
(t 'atom)))
((not (= 0 (boole 1 (bit 2 7) w))) 'fixnum)
((not (= 0 (boole 1 (bit 2 6) w))) 'flonum)
((not (= 0 (boole 1 (bit 2 5) w))) 'bignum-header)
((not (= 0 (boole 1 (bit 2 4) w))) 'symbol-header)
((not (= 0 (boole 1 (bit 2 3) w)))
'Array-header)
((not (= 0 (boole 1 (bit 2 2) w)))
'Value-cell)
((not (= 0 (boole 1 (bit 2 1) w))) 'number-pdl)
((not (= 0 (boole 1 (bit 1 8) w))) 'allocated-random)
((not (= 0 (boole 1 (bit 1 7) w))) 'unallocated-random)
((not (= 0 (boole 1 (bit 1 6) w))) 'pure)
((not (= 0 (boole 1 (bit 1 5) w))) 'hunk)
(t 'unknown)))